home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / nrpas13.arc / RATINT.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-01  |  1KB  |  53 lines
  1. PROCEDURE ratint(xa,ya: glnarray; n: integer; x: real; VAR y,dy: real);
  2. (* Programs using routine RATINT must define the type
  3. TYPE
  4.    glnarray = ARRAY [1..n] OF real;
  5. in the main routine. *)
  6. LABEL 99;
  7. CONST
  8.    tiny=1.0e-25;
  9. VAR
  10.    ns,m,i: integer;
  11.    w,t,hh,h,dd: real;
  12.    c,d: glnarray;
  13. BEGIN
  14.    ns := 1;
  15.    hh := abs(x-xa[1]);
  16.    FOR i := 1 TO n DO BEGIN
  17.       h := abs(x-xa[i]);
  18.       IF  (h = 0.0) THEN BEGIN
  19.          y := ya[i];
  20.          dy := 0.0;
  21.          GOTO 99 END
  22.       ELSE IF (h < hh) THEN BEGIN
  23.          ns := i;
  24.          hh := h
  25.       END;
  26.       c[i] := ya[i];
  27.       d[i] := ya[i]+tiny
  28.    END;
  29.    y := ya[ns];
  30.    ns := ns-1;
  31.    FOR m := 1 TO n-1 DO BEGIN
  32.       FOR i := 1 TO n-m DO BEGIN
  33.          w := c[i+1]-d[i];
  34.          h := xa[i+m]-x;
  35.          t := (xa[i]-x)*d[i]/h;
  36.          dd := t-c[i+1];
  37.          IF (dd = 0.0) THEN BEGIN
  38.             writeln('pause in routine RATINT'); readln
  39.          END;
  40.          dd := w/dd;
  41.          d[i] := c[i+1]*dd;
  42.          c[i] := t*dd
  43.       END;
  44.       IF  (2*ns < n-m) THEN BEGIN
  45.          dy := c[ns+1]
  46.       END ELSE BEGIN
  47.          dy := d[ns];
  48.          ns := ns-1
  49.       END;
  50.       y := y+dy
  51.    END;
  52. 99:   END;
  53.